Tech Arsenal 1

home *** CD-ROM | disk | FTP | other *** search

/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSAM.EXE / TVDIAL.PRG < prev next >

Wrap

Text File | 1993-05-25 | 63KB | 2,089 lines

*-- DBW - Dialog Box Workshop - TVDIAL.PRG PROCEDURE TVDIAL *---------------------------------------------------------------------------- * NAME * DESCRIPTION *---------------------------------------------------------------------------- PRIVATE cAlias, cWindow, lTalk, lSafety, cDialog, cHelpFile, cStartLib IF SET( "TALK" ) = "ON" SET TALK OFF lTalk = .T. ELSE lTalk = .F. ENDIF lSafety = SET( "SAFETY" ) = "ON" SET SAFETY OFF cWindow = WINDOW() cAlias = ALIAS() *---------------------------------- *-- Setup the help system variables *---------------------------------- lError = .F. cHelpFile = "DBBHELP" cDialog = "TVDIAL" cDBBLib = "DBBLIB" *---------------------------------------------- *-- Setup the link to the DBB Procedure Library *---------------------------------------------- ON ERROR lError = .T. cStartLib = SET( "PROCEDURE" ) SET PROCEDURE TO ( cDBBLib ) IF lError lError = .F. SET PROCEDURE TO HOME() + cDBBLib IF lError *-- Display the error message in a windowed box PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,; ll_escape lc_anykey = [Press any key to continue...] ln_press = LEN( lc_anykey ) lc_msg = [Could not locate procedure file: ] + cDBBLib ln_msglen = LEN( lc_msg ) ln_width = 0 ll_escape = SET("ESCAPE") = "ON" SET ESCAPE OFF *-- Determine the width needed for the window: IF ln_msglen <= ln_press ln_width = ln_press ELSE *-- Make sure the message fits in the window: IF ln_msglen > 76 lc_msg = LEFT( lc_msg, 76 ) ln_msglen = 76 ENDIF ln_width = ln_msglen ENDIF DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ; TO 15, (ln_width + 83) / 2 DOUBLE ln_width = ( ln_width + 2 ) *-- Display the message and prompt to the window and wait for a key press ACTIVATE WINDOW _err_box ? lc_msg AT ( ln_width - ln_msglen ) / 2 ? ? lc_anykey AT ( ln_width - ln_press ) / 2 SET CONSOLE OFF WAIT SET CONSOLE ON *-- Clean up the window display and reactivate the previous window RELEASE WINDOW _err_box IF ll_escape SET ESCAPE ON ELSE SET ESCAPE OFF ENDIF ENDIF ENDIF ON ERROR *--------------------------------- *-- Run the actual dialog box code *--------------------------------- IF .NOT. lError DO Dialog ENDIF *---------------------------------- *-- Restore the startup environment *---------------------------------- IF .NOT. ISBLANK( cStartLib ) SET PROCEDURE TO ( cStartLib ) ENDIF IF .NOT. ISBLANK( cAlias ) .AND. SELECT( cAlias ) > 0 SELECT ( cAlias ) ENDIF IF lSafety SET SAFETY ON ENDIF IF lTalk SET TALK ON ENDIF IF .NOT. ISBLANK( cWindow ) ACTIVATE WINDOW &cWindow ENDIF RETURN *-- EOP: TVDIAL PROCEDURE Dialog *---------------------------------------------------------------------------- * NAME * Dialog - * * DESCRIPTION * *---------------------------------------------------------------------------- *--------------------------------------- *-- Temporary for now, message varaibles *--------------------------------------- DLN_OK = -500 DLN_CANCEL = -501 DLN_HELP = -502 WM_PAINT = 15 && Notification to repaint client area WM_CLOSE = 16 && Note that user selected close button WM_DRAWITEM = 43 && Notification to the owner of an BN_CLICKED = 0 BN_PAINT = 1 BN_HILITE = 2 BN_UNHILITE = 3 BN_DISABLE = 4 BN_DEFAULT = 6 BN_PRESSED = 7 BN_COLOR = 8 SE_SHADOW = -100 EN_SETFOCU = 1 EN_KILLFOC = 2 CB_SELECTS = 13 CB_SHOWDRO = 15 CB_HIDELST = 25 CBN_SELCHAN = 1 CBN_DBLCLK = 2 CBN_SETFOCU = 3 CBN_KILLFOC = 4 CBN_EDITCHA = 5 CBN_EDITUPD = 6 CBN_DROPDOW = 7 CBN_INLIST = 8 LBN_SELCHA = 1 LBN_DBLCLK = 2 LBN_SELCAN = 3 LBN_SETFOC = 4 LBN_KILLFO = 5 KB_TAB = 9 KB_ENTER = 13 KB_SPACE = 32 KB_SHIFTTAB = -400 KB_UPARROW = 5 KB_DOWNARROW = 24 KB_LEFTARROW = 19 KB_RTARROW = 4 KB_F1 = 28 KB_ESC = 27 KB_MOUSE = -100 KB_CTRLW = 23 *-------------------- *-- Working variables *-------------------- PRIVATE nCurrent, nCurrGrp, lButtAct, nMRow, nMCol, nMsEvent, nDlgDef, nAccel PRIVATE n1stGrp, nCancelBt nCurrent = 0 && Current dialog object id nCurrGrp = 0 && Current group id for object id lButtAct = .F. && Dialog has a button active nMRow = -1 nMCol = -1 nMsEvent = 0 nDlgDef = 0 nAccel = 0 n1stGrp = 0 nCancelBt = 0 && Id for cancel button PRIVATE nDefButt, nMess nDefButt = 0 && Number of object with default button nMess = 0 PRIVATE cOldFClr, cOldBClr, cOldHClr, cOldMClr, cOldNClr, cOldTClr cOldFClr = _ColorChk( "F" ) cOldBClr = _ColorChk( "B" ) cOldHClr = _ColorChk( "H" ) cOldMClr = _ColorChk( "M" ) cOldNClr = _ColorChk( "N" ) cOldTClr = _ColorChk( "T" ) SET COLOR OF FIELDS TO w+/b SET COLOR OF BOX TO n/gb SET COLOR OF HIGH TO w+/g SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb *------------------------ *-- Close Icon for window *------------------------ PRIVATE nRowCls, nOrigRow, nOrigCol, nXoffset, nYOffset, nCol, ; nHigh, nWidth, nLColCls, nRColCls, nRWinCol, cField, cClass, nScreen cField = "" cClass = "" nRowCls = 3 nOrigRow = 3 nOrigCol = 19 nXOffset = 0 nYOffset = 0 nCol = 19 nHigh = 14 nWidth = 42 nLColCls = 21 nRColCls = 23 nRWinCol = 60 nScreen = IIF( "50" $ SET("DISPLAY"), 49, ; IIF( "43" $ SET("DISPLAY"), 42, 24 ) ) IF SET( "STATUS" ) = "ON" nScreen = nScreen - 3 ENDIF PRIVATE nClkBox, nClkObj, aClkBox, aClkObj, aObjPoint *-------------------------------------------------- *-- Get the number of clickable boxes in the dialog *-------------------------------------------------- nClkBox = 0 *-------------------------------------------------- *-- Get the number of clickable items in the dialog *-------------------------------------------------- nClkObj = 9 DECLARE aClkObj[ 9 , 13 ] aClkObj[ 1 , 1 ] = 6 && Row aClkObj[ 1 , 2 ] = 23 && Col aClkObj[ 1 , 3 ] = 35 && Decimals aClkObj[ 1 , 4 ] = 5 && CurrentId aClkObj[ 1 , 5 ] = 3 && GroupId aClkObj[ 1 , 6 ] = 7 && NextId aClkObj[ 1 , 7 ] = 14 && PrevId aClkObj[ 1 , 8 ] = "H" && PickKey aClkObj[ 1 , 9 ] = 9 && Previous item in group aClkObj[ 1 ,10 ] = 7 && Next item in group aClkObj[ 1 ,11 ] = "CK_CHEZ_1" && [ ] ~Hvarti aClkObj[ 1 ,12 ] = [] aClkObj[ 1 ,13 ] = [] aClkObj[ 2 , 1 ] = 7 && Row aClkObj[ 2 , 2 ] = 23 && Col aClkObj[ 2 , 3 ] = 35 && Decimals aClkObj[ 2 , 4 ] = 7 && CurrentId aClkObj[ 2 , 5 ] = 3 && GroupId aClkObj[ 2 , 6 ] = 9 && NextId aClkObj[ 2 , 7 ] = 5 && PrevId aClkObj[ 2 , 8 ] = "T" && PickKey aClkObj[ 2 , 9 ] = 5 && Previous item in group aClkObj[ 2 ,10 ] = 9 && Next item in group aClkObj[ 2 ,11 ] = "CK_CHEZ_2" && [ ] ~Tilset aClkObj[ 2 ,12 ] = [] aClkObj[ 2 ,13 ] = [] aClkObj[ 3 , 1 ] = 8 && Row aClkObj[ 3 , 2 ] = 23 && Col aClkObj[ 3 , 3 ] = 35 && Decimals aClkObj[ 3 , 4 ] = 9 && CurrentId aClkObj[ 3 , 5 ] = 3 && GroupId aClkObj[ 3 , 6 ] = 6 && NextId aClkObj[ 3 , 7 ] = 7 && PrevId aClkObj[ 3 , 8 ] = "J" && PickKey aClkObj[ 3 , 9 ] = 7 && Previous item in group aClkObj[ 3 ,10 ] = 5 && Next item in group aClkObj[ 3 ,11 ] = "CK_CHEZ_3" && [ ] ~Jarlsberg aClkObj[ 3 ,12 ] = [] aClkObj[ 3 ,13 ] = [] aClkObj[ 4 , 1 ] = 6 && Row aClkObj[ 4 , 2 ] = 46 && Col aClkObj[ 4 , 3 ] = 55 && Decimals aClkObj[ 4 , 4 ] = 6 && CurrentId aClkObj[ 4 , 5 ] = 4 && GroupId aClkObj[ 4 , 6 ] = 8 && NextId aClkObj[ 4 , 7 ] = 9 && PrevId aClkObj[ 4 , 8 ] = "S" && PickKey aClkObj[ 4 , 9 ] = 10 && Previous item in group aClkObj[ 4 ,10 ] = 8 && Next item in group aClkObj[ 4 ,11 ] = "RB_CONS_1" && ( ) ~Solid aClkObj[ 4 ,12 ] = [] aClkObj[ 4 ,13 ] = [] aClkObj[ 5 , 1 ] = 7 && Row aClkObj[ 5 , 2 ] = 46 && Col aClkObj[ 5 , 3 ] = 55 && Decimals aClkObj[ 5 , 4 ] = 8 && CurrentId aClkObj[ 5 , 5 ] = 4 && GroupId aClkObj[ 5 , 6 ] = 10 && NextId aClkObj[ 5 , 7 ] = 6 && PrevId aClkObj[ 5 , 8 ] = "R" && PickKey aClkObj[ 5 , 9 ] = 6 && Previous item in group aClkObj[ 5 ,10 ] = 10 && Next item in group aClkObj[ 5 ,11 ] = "RB_CONS_2" && ( ) ~Runny aClkObj[ 5 ,12 ] = [] aClkObj[ 5 ,13 ] = [] aClkObj[ 6 , 1 ] = 8 && Row aClkObj[ 6 , 2 ] = 46 && Col aClkObj[ 6 , 3 ] = 55 && Decimals aClkObj[ 6 , 4 ] = 10 && CurrentId aClkObj[ 6 , 5 ] = 4 && GroupId aClkObj[ 6 , 6 ] = 12 && NextId aClkObj[ 6 , 7 ] = 8 && PrevId aClkObj[ 6 , 8 ] = "M" && PickKey aClkObj[ 6 , 9 ] = 8 && Previous item in group aClkObj[ 6 ,10 ] = 6 && Next item in group aClkObj[ 6 ,11 ] = "RB_CONS_3" && ( ) ~Melted aClkObj[ 6 ,12 ] = [] aClkObj[ 6 ,13 ] = [] aClkObj[ 7 , 1 ] = 12 && Row aClkObj[ 7 , 2 ] = 22 && Col aClkObj[ 7 , 3 ] = 56 && Decimals aClkObj[ 7 , 4 ] = 12 && CurrentId aClkObj[ 7 , 5 ] = 11 && GroupId aClkObj[ 7 , 6 ] = 13 && NextId aClkObj[ 7 , 7 ] = 10 && PrevId aClkObj[ 7 , 8 ] = " " && PickKey aClkObj[ 7 , 9 ] = 12 && Previous item in group aClkObj[ 7 ,10 ] = 12 && Next item in group aClkObj[ 7 ,11 ] = "EF_DELV_1" && XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX aClkObj[ 7 ,12 ] = [] aClkObj[ 7 ,13 ] = [] aClkObj[ 8 , 1 ] = 14 && Row aClkObj[ 8 , 2 ] = 28 && Col aClkObj[ 8 , 3 ] = 35 && Decimals aClkObj[ 8 , 4 ] = 13 && CurrentId aClkObj[ 8 , 5 ] = 13 && GroupId aClkObj[ 8 , 6 ] = 14 && NextId aClkObj[ 8 , 7 ] = 12 && PrevId aClkObj[ 8 , 8 ] = "O" && PickKey aClkObj[ 8 , 9 ] = 13 && Previous item in group aClkObj[ 8 ,10 ] = 13 && Next item in group aClkObj[ 8 ,11 ] = "BT_OK" && ~Ok aClkObj[ 8 ,12 ] = [] aClkObj[ 8 ,13 ] = [] aClkObj[ 9 , 1 ] = 14 && Row aClkObj[ 9 , 2 ] = 42 && Col aClkObj[ 9 , 3 ] = 49 && Decimals aClkObj[ 9 , 4 ] = 14 && CurrentId aClkObj[ 9 , 5 ] = 14 && GroupId aClkObj[ 9 , 6 ] = 5 && NextId aClkObj[ 9 , 7 ] = 13 && PrevId aClkObj[ 9 , 8 ] = "C" && PickKey aClkObj[ 9 , 9 ] = 14 && Previous item in group aClkObj[ 9 ,10 ] = 14 && Next item in group aClkObj[ 9 ,11 ] = "BT_CANCEL" && ~Cancel aClkObj[ 9 ,12 ] = [] aClkObj[ 9 ,13 ] = [] nCancelBt = 14 *------------------------------------------------------------- *-- Setup object pointers in to the current object array above *------------------------------------------------------------- DECLARE aObjPoint[ 14 ] aObjPoint[ 5 ] = 1 aObjPoint[ 7 ] = 2 aObjPoint[ 9 ] = 3 aObjPoint[ 6 ] = 4 aObjPoint[ 8 ] = 5 aObjPoint[ 10 ] = 6 aObjPoint[ 12 ] = 7 aObjPoint[ 13 ] = 8 aObjPoint[ 14 ] = 9 *------------------------------------------------------------------- *-- Setup private memory variables for object states (from InitObjs) *-- First variable with the object memvar name contains the value *-- for the object. The second varaible, if present, indicates *-- the id of the object previously active in the group. *------------------------------------------------------------------- PRIVATE ck_chez_1 ck_chez_1 = "" PRIVATE nCk_chez nCk_chez = 5 PRIVATE ck_chez_2 ck_chez_2 = "" PRIVATE ck_chez_3 ck_chez_3 = "" PRIVATE rb_cons_1 rb_cons_1 = "" PRIVATE nRb_cons nRb_cons = 6 PRIVATE rb_cons_2 rb_cons_2 = "" PRIVATE rb_cons_3 rb_cons_3 = "" PRIVATE ef_delv_1 ef_delv_1 = "" PRIVATE bt_ok bt_ok = "" PRIVATE bt_cancel bt_cancel = "" DO InitObjs DO DrawDial && Draw all the dialog objects *-------------------------------- *-- Set focus to the first object *-------------------------------- DO GetNext WITH nCurrent, .T. *-- The message loop nMess = 0 DO WHILE .NOT. GetMess() DO Dispatch IF nMess = DLN_OK .OR. nMess = DLN_CANCEL EXIT ENDIF ENDDO IF nMess = DLN_OK DO PostVals FXL_Cancel = .F. ELSE FXL_Cancel = .T. ENDIF RELEASE WINDOW TVDIAL RESTORE SCREEN FROM TVDIAL RELEASE SCREEN TVDIAL DO ReleObjs SET COLOR OF FIELDS TO &cOldFClr SET COLOR OF BOX TO &cOldBClr SET COLOR OF HIGH TO &cOldHClr SET COLOR OF MESS TO &cOldMClr SET COLOR OF TITLE TO &cOldTClr SET CURSOR ON RETURN *-- EOP: Dialog PROCEDURE InitObjs *---------------------------------------------------------------------------- * NAME * InitObjs - Scan the design DBF file and initialize the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE cField, cClass, cDefault, Value, lInitDef *-------------------------------------------------- *-- Determine if an initialization array is present *-------------------------------------------------- lInitDef = TYPE( "TVDIAL[1]" ) <> "U" *------------------------------- *-- Set the default button value *------------------------------- nDlgDef = 13 *----------------------------------------------------------------- *-- If the Initialize array is present, then set the object values *-- based on the array. *----------------------------------------------------------------- IF lInitDef CK_CHEZ_1 = TVDIAL[ 1 ] CK_CHEZ_2 = TVDIAL[ 2 ] CK_CHEZ_3 = TVDIAL[ 3 ] IF TVDIAL[ 4 ] && If this button is active nRB_CONS = 6 && Set the tab into value to this button ENDIF RB_CONS_1 = TVDIAL[ 4 ] IF TVDIAL[ 5 ] && If this button is active nRB_CONS = 8 && Set the tab into value to this button ENDIF RB_CONS_2 = TVDIAL[ 5 ] IF TVDIAL[ 6 ] && If this button is active nRB_CONS = 10 && Set the tab into value to this button ENDIF RB_CONS_3 = TVDIAL[ 6 ] EF_DELV_1 = TVDIAL[ 7 ] BT_OK = TVDIAL[ 8 ] BT_CANCEL = TVDIAL[ 9 ] ELSE *-------------------------------------------------------- *-- Otherwise, use the values stored in the resource file *-------------------------------------------------------- CK_CHEZ_1 = .F. CK_CHEZ_2 = .F. CK_CHEZ_3 = .F. RB_CONS_1 = .F. RB_CONS_2 = .F. RB_CONS_3 = .T. nRB_CONS = 10 && Store the group default value EF_DELV_1 = "PHONE HOME " BT_OK = .T. BT_CANCEL = .F. ENDIF nCurrent = 5 && Current dialog object id nCurrGrp = 3 && Current group id for object id n1stGrp = 3 RETURN *-- EOP: InitObjs PROCEDURE DrawDial *---------------------------------------------------------------------------- * NAME * DrawDial - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lInitDef lInitDef = TYPE( "TVDIAL[1]" ) <> "U" IF FILE( "TVDIAL.WIN" ) .AND. ( .NOT. lInitDef .OR. ; ( TYPE( "FXL_NoChng" ) = "L" .AND. FXL_NoChng ) ) *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO TVDIAL ACTIVATE SCREEN @ 4, 20 FILL TO 17, 61 RESTORE WINDOW TVDIAL FROM TVDIAL ACTIVATE WINDOW TVDIAL ELSE *------------------------- *-- Draw the dialog window *------------------------- *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO TVDIAL ACTIVATE SCREEN @ 4, 20 FILL TO 17, 61 DEFINE WINDOW TVDIAL FROM 3,19 TO 16,60 NONE COLOR n/w ACTIVATE WINDOW TVDIAL @ 0, 0 TO 13 , 41 DOUBLE COLOR w+/w *------------------------ *-- Close Icon for window *------------------------ @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w *--------------------------------- *-- Draw the other control objects *--------------------------------- @ 0,13 SAY "Demo Dialog Box" COLOR w+/w DO TStatic WITH WM_PAINT, BN_PAINT, 3 DO TButton WITH WM_PAINT, BN_PAINT, 5 DO TButton WITH WM_PAINT, BN_PAINT, 7 DO TButton WITH WM_PAINT, BN_PAINT, 9 DO TStatic WITH WM_PAINT, BN_PAINT, 4 DO TButton WITH WM_PAINT, BN_PAINT, 6 DO TButton WITH WM_PAINT, BN_PAINT, 8 DO TButton WITH WM_PAINT, BN_PAINT, 10 DO TStatic WITH WM_PAINT, BN_PAINT, 11 DO TEdit WITH WM_PAINT, EN_KILLFOC, 12 DO TButton WITH WM_PAINT, BN_PAINT, 13 DO TButton WITH WM_PAINT, SE_SHADOW, 13 DO TButton WITH WM_PAINT, BN_PAINT, 14 DO TButton WITH WM_PAINT, SE_SHADOW, 14 IF .NOT. lInitDef SAVE WINDOW TVDIAL TO TVDIAL ENDIF ENDIF RETURN *-- EOP: DrawDial PROCEDURE TStatic PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TStatic - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 3 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 2, 3 SAY "Cheeses" COLOR n/w CASE pc_data = BN_HILITE @ 2, 3 SAY "Cheeses" COLOR w+/w CASE pc_data = BN_DISABLE @ 2, 3 SAY "Cheeses" COLOR n+/w CASE pc_data = BN_COLOR @ 2, 3 SAY "Cheeses" COLOR n/w ENDCASE CASE pnObject = 4 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 2, 26 SAY "Consistency" COLOR n/w CASE pc_data = BN_HILITE @ 2, 26 SAY "Consistency" COLOR w+/w CASE pc_data = BN_DISABLE @ 2, 26 SAY "Consistency" COLOR n+/w CASE pc_data = BN_COLOR @ 2, 26 SAY "Consistency" COLOR n/w ENDCASE CASE pnObject = 11 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 8, 3 SAY "Delivery instructions" COLOR n/w CASE pc_data = BN_HILITE @ 8, 3 SAY "Delivery instructions" COLOR w+/w CASE pc_data = BN_DISABLE @ 8, 3 SAY "Delivery instructions" COLOR n+/w CASE pc_data = BN_COLOR @ 8, 3 SAY "Delivery instructions" COLOR n/w ENDCASE IF pc_data <> BN_DISABLE @ 8, 3 SAY "D" COLOR gr+/w ENDIF ENDCASE RETURN *-- EOP: TStatic WITH pn_msg, pc_data, pnObject PROCEDURE HasTitle PARAMETERS pnObject, pnWay *---------------------------------------------------------------------------- * NAME * HasTitle - Display the label for the group of objects * * DESCRIPTION * * PARAMETERS * pnObject = nCurrent value for group item * pnWay = BN_HILITE, BN_UNHILITE, or BN_DISABLE * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 5 DO TStatic WITH WM_PAINT, pnWay, 3 CASE pnObject = 7 DO TStatic WITH WM_PAINT, pnWay, 3 CASE pnObject = 9 DO TStatic WITH WM_PAINT, pnWay, 3 CASE pnObject = 6 DO TStatic WITH WM_PAINT, pnWay, 4 CASE pnObject = 8 DO TStatic WITH WM_PAINT, pnWay, 4 CASE pnObject = 10 DO TStatic WITH WM_PAINT, pnWay, 4 CASE pnObject = 12 DO TStatic WITH WM_PAINT, pnWay, 11 ENDCASE *-- EOP: HasTitle WITH pnObject, pnWay FUNCTION GetMess *---------------------------------------------------------------------------- * NAME * GetMess() - * DEPENDENCIES * Uses nCurrent to determine the wait state for the given object. *---------------------------------------------------------------------------- PRIVATE lRtn DO CASE CASE nCurrent = 5 && CK_CHEZ_1 DO GetWait CASE nCurrent = 7 && CK_CHEZ_2 DO GetWait CASE nCurrent = 9 && CK_CHEZ_3 DO GetWait CASE nCurrent = 6 && RB_CONS_1 DO GetWait CASE nCurrent = 8 && RB_CONS_2 DO GetWait CASE nCurrent = 10 && RB_CONS_3 DO GetWait CASE nCurrent = 12 && EF_DELV_1 ON KEY LABEL F1 DO DlgHlpHd DO GetEdit ON KEY LABEL F1 CASE nCurrent = 13 && BT_OK DO GetWait CASE nCurrent = 14 && BT_CANCEL DO TButton WITH WM_PAINT, BN_UNHILITE, 13 BT_CANCEL = .F. DO GetWait ENDCASE IF nMess = KB_F1 DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile ENDIF IF nMess = KB_ESC lRtn = .T. ELSE lRtn = .F. ENDIF RETURN lRtn *-- EOF: GetMess( ) PROCEDURE DlgHlpHd *---------------------------------------------------------------------------- * NAME * DlgHlpHd - * * DESCRIPTION * *---------------------------------------------------------------------------- DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile nMess = 0 RETURN *-- EOP: DlgHlpHd PROCEDURE GetWait *---------------------------------------------------------------------------- * NAME * GetWait - * * DESCRIPTION * *---------------------------------------------------------------------------- nMess = 0 nAccel = 0 lButtAct = .T. DO TButton WITH WM_PAINT, BN_HILITE, nCurrent SET CONSOLE OFF SET CURSOR OFF WAIT SET CONSOLE ON nMess = LASTKEY() nMRow = MROW() nMCol = MCOL() RETURN *-- EOP: GetWait PROCEDURE TButton PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TButton - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 5 && CK_CHEZ_1 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 3, 4 SAY "[ ] Hvarti " COLOR n/gb @ 3, 5 SAY IIF( CK_CHEZ_1 , "X"," " ) COLOR n/gb CASE pc_data = BN_HILITE @ 3, 4 SAY "[ ] Hvarti " COLOR w+/gb @ 3, 5 SAY IIF( CK_CHEZ_1 , "X"," " ) COLOR w+/gb CASE pc_data = BN_DISABLE @ 3, 4 SAY "[ ] Hvarti " COLOR n+/gb @ 3, 5 SAY IIF( CK_CHEZ_1 , "X"," " ) COLOR n+/gb ENDCASE IF pc_data <> BN_DISABLE @ 3, 8 SAY "H" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF CK_CHEZ_1 STORE .F. TO CK_CHEZ_1 ELSE STORE .T. TO CK_CHEZ_1 ENDIF DO TButton WITH WM_PAINT, BN_HILITE, 5 ENDCASE CASE pnObject = 7 && CK_CHEZ_2 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 4, 4 SAY "[ ] Tilset " COLOR n/gb @ 4, 5 SAY IIF( CK_CHEZ_2 , "X"," " ) COLOR n/gb CASE pc_data = BN_HILITE @ 4, 4 SAY "[ ] Tilset " COLOR w+/gb @ 4, 5 SAY IIF( CK_CHEZ_2 , "X"," " ) COLOR w+/gb CASE pc_data = BN_DISABLE @ 4, 4 SAY "[ ] Tilset " COLOR n+/gb @ 4, 5 SAY IIF( CK_CHEZ_2 , "X"," " ) COLOR n+/gb ENDCASE IF pc_data <> BN_DISABLE @ 4, 8 SAY "T" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF CK_CHEZ_2 STORE .F. TO CK_CHEZ_2 ELSE STORE .T. TO CK_CHEZ_2 ENDIF DO TButton WITH WM_PAINT, BN_HILITE, 7 ENDCASE CASE pnObject = 9 && CK_CHEZ_3 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 5, 4 SAY "[ ] Jarlsberg " COLOR n/gb @ 5, 5 SAY IIF( CK_CHEZ_3 , "X"," " ) COLOR n/gb CASE pc_data = BN_HILITE @ 5, 4 SAY "[ ] Jarlsberg " COLOR w+/gb @ 5, 5 SAY IIF( CK_CHEZ_3 , "X"," " ) COLOR w+/gb CASE pc_data = BN_DISABLE @ 5, 4 SAY "[ ] Jarlsberg " COLOR n+/gb @ 5, 5 SAY IIF( CK_CHEZ_3 , "X"," " ) COLOR n+/gb ENDCASE IF pc_data <> BN_DISABLE @ 5, 8 SAY "J" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF CK_CHEZ_3 STORE .F. TO CK_CHEZ_3 ELSE STORE .T. TO CK_CHEZ_3 ENDIF DO TButton WITH WM_PAINT, BN_HILITE, 9 ENDCASE CASE pnObject = 6 && RB_CONS_1 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 3, 27 SAY "( ) Solid " COLOR n/gb IF RB_CONS_1 @ 3, 28 TO 3, 28 7 COLOR n/gb ELSE @ 3, 28 SAY " " COLOR n/gb ENDIF CASE pc_data = BN_HILITE @ 3, 27 SAY "( ) Solid " COLOR w+/gb IF RB_CONS_1 @ 3, 28 TO 3, 28 7 COLOR w+/gb ELSE @ 3, 28 SAY " " COLOR w+/gb ENDIF CASE pc_data = BN_DISABLE @ 3, 27 SAY "( ) Solid " COLOR n+/gb IF RB_CONS_1 @ 3, 28 TO 3, 28 7 COLOR n+/gb ELSE @ 3, 28 SAY " " COLOR n+/gb ENDIF ENDCASE IF pc_data <> BN_DISABLE @ 3, 31 SAY "S" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF RB_CONS_1 STORE .F. TO RB_CONS_1 ELSE STORE .T. TO RB_CONS_1 ENDIF ENDCASE CASE pnObject = 8 && RB_CONS_2 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 4, 27 SAY "( ) Runny " COLOR n/gb IF RB_CONS_2 @ 4, 28 TO 4, 28 7 COLOR n/gb ELSE @ 4, 28 SAY " " COLOR n/gb ENDIF CASE pc_data = BN_HILITE @ 4, 27 SAY "( ) Runny " COLOR w+/gb IF RB_CONS_2 @ 4, 28 TO 4, 28 7 COLOR w+/gb ELSE @ 4, 28 SAY " " COLOR w+/gb ENDIF CASE pc_data = BN_DISABLE @ 4, 27 SAY "( ) Runny " COLOR n+/gb IF RB_CONS_2 @ 4, 28 TO 4, 28 7 COLOR n+/gb ELSE @ 4, 28 SAY " " COLOR n+/gb ENDIF ENDCASE IF pc_data <> BN_DISABLE @ 4, 31 SAY "R" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF RB_CONS_2 STORE .F. TO RB_CONS_2 ELSE STORE .T. TO RB_CONS_2 ENDIF ENDCASE CASE pnObject = 10 && RB_CONS_3 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 5, 27 SAY "( ) Melted " COLOR n/gb IF RB_CONS_3 @ 5, 28 TO 5, 28 7 COLOR n/gb ELSE @ 5, 28 SAY " " COLOR n/gb ENDIF CASE pc_data = BN_HILITE @ 5, 27 SAY "( ) Melted " COLOR w+/gb IF RB_CONS_3 @ 5, 28 TO 5, 28 7 COLOR w+/gb ELSE @ 5, 28 SAY " " COLOR w+/gb ENDIF CASE pc_data = BN_DISABLE @ 5, 27 SAY "( ) Melted " COLOR n+/gb IF RB_CONS_3 @ 5, 28 TO 5, 28 7 COLOR n+/gb ELSE @ 5, 28 SAY " " COLOR n+/gb ENDIF ENDCASE IF pc_data <> BN_DISABLE @ 5, 31 SAY "M" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF RB_CONS_3 STORE .F. TO RB_CONS_3 ELSE STORE .T. TO RB_CONS_3 ENDIF ENDCASE CASE pnObject = 13 && BT_OK DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 11, 9 SAY " Ok " COLOR bg+/g CASE pc_data = BN_HILITE @ 11, 9 SAY " Ok " COLOR w+/g CASE pc_data = BN_UNHILITE @ 11, 9 SAY " Ok " COLOR n/g CASE pc_data = BN_DEFAULT @ 11, 9 SAY " Ok " COLOR bg+/g CASE pc_data = BN_DISABLE @ 11, 9 SAY " Ok " COLOR n+/g CASE pc_data = SE_SHADOW @ 12, 10 SAY "▀▀▀▀▀▀▀▀" COLOR n/w @ 11, 17 SAY "▄" COLOR n/w CASE pc_data = BN_PRESSED @ 12, 10 SAY SPACE( 8 ) COLOR n/w @ 11, 9 SAY " " COLOR n/w @ 11, 17 SAY " " COLOR n/w @ 11, 10 SAY " Ok " COLOR w+/g ENDCASE IF pc_data <> BN_PRESSED .AND. pc_data <> BN_DISABLE @ 11, 12 SAY "O" COLOR gr+/g ENDIF CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 13 x = INKEY( .2 ) nMess = DLN_OK DO TButton WITH WM_PAINT, BN_PAINT, 13 DO TButton WITH WM_PAINT, SE_SHADOW, 13 ENDCASE CASE pnObject = 14 && BT_CANCEL DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 11, 23 SAY " Cancel " COLOR n/g CASE pc_data = BN_HILITE @ 11, 23 SAY " Cancel " COLOR w+/g CASE pc_data = BN_UNHILITE @ 11, 23 SAY " Cancel " COLOR n/g CASE pc_data = BN_DEFAULT @ 11, 23 SAY " Cancel " COLOR bg+/g CASE pc_data = BN_DISABLE @ 11, 23 SAY " Cancel " COLOR n+/g CASE pc_data = SE_SHADOW @ 12, 24 SAY "▀▀▀▀▀▀▀▀" COLOR n/w @ 11, 31 SAY "▄" COLOR n/w CASE pc_data = BN_PRESSED @ 12, 24 SAY SPACE( 8 ) COLOR n/w @ 11, 23 SAY " " COLOR n/w @ 11, 31 SAY " " COLOR n/w @ 11, 24 SAY " Cancel " COLOR w+/g ENDCASE IF pc_data <> BN_PRESSED .AND. pc_data <> BN_DISABLE @ 11, 24 SAY "C" COLOR gr+/g ENDIF CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 14 x = INKEY( .2 ) nMess = DLN_CANCEL DO TButton WITH WM_PAINT, BN_PAINT, 14 DO TButton WITH WM_PAINT, SE_SHADOW, 14 ENDCASE ENDCASE RETURN *-- EOP: TButton WITH pn_msg, pc_data, pnObject PROCEDURE GetEdit *---------------------------------------------------------------------------- * NAME * GetEdit - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lSkipRead lSkipRead = .F. nMess = 0 nAccel = 0 nMsEvent = 0 ON MOUSE DO MsHand WITH MROW(), MCOL() DO SetOnKey DO CASE CASE nCurrent = 12 @ 9, 3 GET EF_DELV_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ENDCASE IF .NOT. lSkipRead SET CURSOR ON READ SET CURSOR OFF ENDIF DO ClrOnKey ON MOUSE IF .NOT. lSkipRead IF nMsEvent = KB_MOUSE nMess = KB_MOUSE ELSE nMess = LASTKEY() ENDIF ELSE nMess = KB_DOWNARROW ENDIF RETURN *-- EOP: GetEdit PROCEDURE TEdit PARAMETERS pn_msg, p__data, pnObject *---------------------------------------------------------------------------- * NAME * TEdit - * * DESCRIPTION * * PARAMETERS * pn_msg = * p__data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 12 && EF_DELV_1 DO CASE CASE p__data = EN_KILLFOC @ 9, 3 GET EF_DELV_1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" CLEAR GETS ENDCASE ENDCASE RETURN *-- EOP: TEdit WITH pn_msg, p__data, pnObject PROCEDURE SetOnKey *---------------------------------------------------------------------------- * NAME * SetOnKey - For each pick key, set on key label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-H DO AKeyHand WITH '5' ON KEY LABEL Alt-T DO AKeyHand WITH '7' ON KEY LABEL Alt-J DO AKeyHand WITH '9' ON KEY LABEL Alt-S DO AKeyHand WITH '6' ON KEY LABEL Alt-R DO AKeyHand WITH '8' ON KEY LABEL Alt-M DO AKeyHand WITH '10' ON KEY LABEL Alt-D DO AKeyHand WITH '12' ON KEY LABEL Alt-O DO AKeyHand WITH '13' ON KEY LABEL Alt-C DO AKeyHand WITH '14' RETURN *-- EOP: SetOnKey PROCEDURE ClrOnKey *---------------------------------------------------------------------------- * NAME * ClrOnKey - For each pick key, clear on label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-H ON KEY LABEL Alt-T ON KEY LABEL Alt-J ON KEY LABEL Alt-S ON KEY LABEL Alt-R ON KEY LABEL Alt-M ON KEY LABEL Alt-D ON KEY LABEL Alt-O ON KEY LABEL Alt-C RETURN *-- EOP: ClrOnKey PROCEDURE AKeyHand PARAMETERS cId *---------------------------------------------------------------------------- * NAME * AKeyHand - On key handler for Accel key from popup or get * * DESCRIPTION * * PARAMETERS * nId = * *---------------------------------------------------------------------------- IF nAccel <> nCurrent nAccel = VAL( cId ) KEYBOARD "{Ctrl-W}" nMess = KB_CTRLW ELSE nAccel = 0 ENDIF RETURN *-- EOP: AKeyHand WITH nId PROCEDURE CkWaitAc *---------------------------------------------------------------------------- * NAME * CkWaitAc - Look for Accel key from Wait command * * DESCRIPTION * This routine has high International risk for translations. *---------------------------------------------------------------------------- IF nMess < 0 nAccPress = nMess + 500 ELSE IF nMess >= 97 .AND. nMess <= 122 nMess = nMess - 32 ENDIF nAccPress = nMess ENDIF DO CASE CASE nAccPress = 72 && H - CK_CHEZ_1 nAccel = 5 CASE nAccPress = 84 && T - CK_CHEZ_2 nAccel = 7 CASE nAccPress = 74 && J - CK_CHEZ_3 nAccel = 9 CASE nAccPress = 83 && S - RB_CONS_1 nAccel = 6 CASE nAccPress = 82 && R - RB_CONS_2 nAccel = 8 CASE nAccPress = 77 && M - RB_CONS_3 nAccel = 10 CASE nAccPress = 68 && D - EF_DELV_0 nAccel = 12 CASE nAccPress = 79 && O - BT_OK nAccel = 13 CASE nAccPress = 67 && C - BT_CANCEL nAccel = 14 OTHERWISE nAccel = 0 ENDCASE RETURN *-- EOP: CkWaitAc FUNCTION GetMsTo PARAMETER plChkOnly *---------------------------------------------------------------------------- * NAME * GetMsTo() - * * DESCRIPTION * *---------------------------------------------------------------------------- *-- Check for a click on the close button IF nMRow = nRowCls .AND. nMCol >= nLColCls .AND. nMCol <= nRColCls nMess = DLN_CANCEL nRtn = 0 ELSE IF nMRow = nRowCls .AND. nMCol >= nCol .AND. nMCol <= nRWinCol *--------------------------------------------------------- *-- All this to remove the shadow before moving the window *--------------------------------------------------------- SAVE WINDOW TVDIAL TO _TVDIAL RELEASE WINDOW TVDIAL RESTORE SCREEN FROM TVDIAL RESTORE WINDOW TVDIAL FROM _TVDIAL ERASE _TVDIAL.win ACTIVATE WINDOW TVDIAL @ 0, 0 TO nHigh - 1, nWidth - 1 COLOR g+/w @ 0, 2 SAY "[ ]" COLOR g+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 13 SAY "Demo Dialog Box" COLOR g+/w *------------------------------- *-- Start the move window action *------------------------------- nDelX = nMRow nDelY = nMCol SET CONSOLE OFF WAIT SET CONSOLE ON nMRow = MROW() nMCol = MCOL() nDelX = nMRow - nDelX nDelY = nMCol - nDelY lMoveOk = .T. ON ERROR lMoveOk = .F. MOVE WINDOW TVDIAL BY nDelX, nDelY ON ERROR IF lMoveOk nRowCls = nRowCls + nDelX nCol = nCol + nDelY nLColCls = ncol + 2 && Left column for close button nRColCls = ncol + 4 && End column for close button nRWinCol = ncol + nWidth - 1 && Rigth column for window nXOffset = nRowCls - nOrigRow nYOffset = nCol - nOrigCol ENDIF *--------------------------------------------------------- *-- Display the new shadow for after moving the dialog box *--------------------------------------------------------- SAVE WINDOW TVDIAL TO _TVDIAL RELEASE WINDOW TVDIAL RESTORE SCREEN FROM TVDIAL ACTIVATE SCREEN IF nCol + 42 < 80 .AND. nRowCls + 14 <= nScreen @ nRowCls + 1, nCol + 1 FILL TO nRowCls + 14, nCol + 42 COLOR n+/n ENDIF RESTORE WINDOW TVDIAL FROM _TVDIAL ERASE _TVDIAL.win ACTIVATE WINDOW TVDIAL @ 0, 0 TO nHigh - 1, nWidth - 1 DOUBLE COLOR w+/w @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 13 SAY "Demo Dialog Box" COLOR w+/w nRtn = -1 ELSE *----------------------------------- *-- Check for click on a live object *----------------------------------- nRtn = 0 i = 1 DO WHILE i <= nClkObj IF nMRow = aClkObj[ i, 1 ] + nXOffSet .AND. ; nMCol >= aClkObj[ i, 2 ] + nYOffset .AND. ; nMCol <= aClkObj[ i, 3 ] + nYOffset nRtn = aClkObj[ i, 4 ] EXIT ENDIF i = i + 1 ENDDO IF nRtn = 0 *---------------------------------------------------------- *-- Not found, check for a click in a Combo box or list box *---------------------------------------------------------- IF nClkBox > 0 i = 1 DO WHILE i <= nClkBox IF nMRow >= aClkBox[ i, 1 ] + nXOffset .AND. ; nMRow <= aClkBox[ i, 1 ] + nXOffset + aClkBox[ i, 2 ] .AND. ; nMCol >= aClkBox[ i, 3 ] + nYOffset .AND. ; nMCol <= aClkBox[ i, 3 ] + nYOffset + aClkBox[ i, 4 ] nRtn = aClkBox[ i, 5 ] - 1 aClkBox[ i, 6 ] = .T. EXIT ENDIF i = i + 1 ENDDO ENDIF ENDIF ENDIF ENDIF RETURN( nRtn ) *-- EOF: GetMsTo( ) PROCEDURE MsHand PARAMETERS pnMRow, pnMCol, pl_IsPop *---------------------------------------------------------------------------- * NAME * MsHand - * * DESCRIPTION * * PARAMETERS * pnMRow = * pnMCol = * pl_IsPop = * *---------------------------------------------------------------------------- nMRow = pnMRow nMCol = pnMCol nMsEvent = KB_MOUSE KEYBOARD "{Ctrl-W}" RETURN *-- EOP: MsHand WITH pnMRow, pnMCol, pl_IsPop PROCEDURE Dispatch *---------------------------------------------------------------------------- * NAME * Dispatch - * * DESCRIPTION * *---------------------------------------------------------------------------- DO CASE CASE nCurrent = 5 && CK_CHEZ_1 DO DispCk CASE nCurrent = 7 && CK_CHEZ_2 DO DispCk CASE nCurrent = 9 && CK_CHEZ_3 DO DispCk CASE nCurrent = 6 && RB_CONS_1 DO DispRb CASE nCurrent = 8 && RB_CONS_2 DO DispRb CASE nCurrent = 10 && RB_CONS_3 DO DispRb CASE nCurrent = 12 && EF_DELV_1 DO DispEf CASE nCurrent = 13 && BT_OK DO DispBt CASE nCurrent = 14 && BT_CANCEL DO DispBt ENDCASE RETURN *-- EOP: Dispatch PROCEDURE DispRb *---------------------------------------------------------------------------- * NAME * DispRb - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_UPARROW .OR. nMess = KB_LEFTARROW DO TButton WITH BN_CLICKED, .F., nCurrent DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F., .T. DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_DOWNARROW .OR. nMess = KB_RTARROW DO TButton WITH BN_CLICKED, .F., nCurrent DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T., .T. DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext <> nCurrent DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF CASE nMess = KB_ENTER IF nDlgDef > 0 DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel <> nCurrent DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispRb PROCEDURE DispCk *---------------------------------------------------------------------------- * NAME * DispCk - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_UPARROW .OR. nMess = KB_LEFTARROW DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F., .T. CASE nMess = KB_DOWNARROW .OR. nMess = KB_RTARROW DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T., .T. CASE nMess = KB_SPACE DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF CASE nMess = KB_ENTER IF nDlgDef > 0 DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispCk PROCEDURE DispBt *---------------------------------------------------------------------------- * NAME * DispBt - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_ENTER DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispBt PROCEDURE DispEf *---------------------------------------------------------------------------- * NAME * DispEf - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. CASE nMess = KB_ENTER IF nDlgDef > 0 DO GetNext WITH nDlgDef IF nCurrent = nDlgDef DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF ENDIF CASE nMess = KB_UPARROW DO GetNext WITH .F., .T. CASE nMess = KB_DOWNARROW DO GetNext WITH .T., .T. CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 DO GetNext WITH nPossNext, .F. ENDIF CASE nMess = KB_CTRLW .AND. nAccel > 0 DO GetNext WITH nAccel, .F. ENDCASE RETURN *-- EOP: DispEf PROCEDURE GetNext PARAMETERS p__dir, pl_SameGrp *---------------------------------------------------------------------------- * NAME * GetNext - * * DESCRIPTION * * PARAMETERS * p__dir = .T. to go forward, .F. to go back, number to go to * record number. * pl_SameGrp = .F. to go to first item in next/prev group, .T. will * go to the next/prev item within the same group. Only * applies to p__dir being next/previous. * *---------------------------------------------------------------------------- PRIVATE cPrevClass, nWay, npCurrent, nPointer, nNextObj, nNextPtr PRIVATE nRecNo, npRecNo, lExit, cField, cVar, cCurrClass *------------------------------------------ *-- Check for move out of the current group *------------------------------------------ IF .NOT. pl_SameGrp IF TYPE( "p__dir" ) = "L" DO HasTitle WITH nCurrent, BN_UNHILITE ENDIF ENDIF cPrevClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) *-------------------------------------------------- *-- Set the current CK or RB pointer before leaving *-------------------------------------------------- DO CASE CASE nCurrent = 5 && CK_CHEZ_1 STORE nCurrent TO nCK_CHEZ CASE nCurrent = 7 && CK_CHEZ_2 STORE nCurrent TO nCK_CHEZ CASE nCurrent = 9 && CK_CHEZ_3 STORE nCurrent TO nCK_CHEZ CASE nCurrent = 6 && RB_CONS_1 STORE nCurrent TO nRB_CONS CASE nCurrent = 8 && RB_CONS_2 STORE nCurrent TO nRB_CONS CASE nCurrent = 10 && RB_CONS_3 STORE nCurrent TO nRB_CONS ENDCASE *---------------------------------------- *-- Handle the forward and backward moves *---------------------------------------- IF TYPE( "p__dir" ) = "L" DO CASE *------------------------------------------- *-- Go forward or backward in the same group *------------------------------------------- CASE pl_SameGrp nWay = IIF( p__dir, 10, 9 ) && 10 Forward, 9 Back npCurrent = aObjPoint[ nCurrent ] nPointer = npCurrent *----------------------------------------------- *-- Is this a one item radio button or check box *----------------------------------------------- IF aClkObj[ npCurrent, 4 ] <> aClkObj[ npCurrent, nWay ] DO WHILE .T. *------------------------------------------------------ *-- Check to see if the next object's WHEN clause is Ok *------------------------------------------------------ nNextObj = aClkObj[ nPointer, nWay ] IF WhenOk( nNextObj ) nPointer = aObjPoint[ nNextObj ] EXIT ELSE *----------------------------------------------- *-- See if we looped back to the item we were on *----------------------------------------------- nNextPtr = aObjPoint[ nNextObj ] IF nNextPtr = npCurrent EXIT ELSE nPointer = nNextPtr ENDIF ENDIF ENDDO ENDIF IF nPointer <> npCurrent nCurrent = aClkObj[ nPointer, 4 ] nCurrGrp = aClkObj[ nPointer, 5 ] ENDIF OTHERWISE nWay = IIF( p__dir, 6, 7 ) && 6 Forward, 7 Back nRecNo = nCurrent npRecNo = aObjPoint[ nRecNo ] lExit = .F. DO WHILE aClkObj[ npRecNo, 5 ] = nCurrGrp nRecNo = aClkObj[ npRecNo, nWay ] npRecNo = aObjPoint[ nRecNo ] IF aClkObj[ npRecNo, 5 ] = nCurrGrp LOOP ELSE *-------------------------------------------------- *-- Finally, we have moved out of the current group *-------------------------------------------------- nCurrGrp = aClkObj[ npRecNo, 5 ] IF .NOT. WhenOk( nRecNo ) LOOP ELSE nCurrent = nRecNo lExit = .T. ENDIF ENDIF *--------------------------------------------------------- *-- Was this a move into a radio button or check box group *--------------------------------------------------------- cField = aClkObj[ npRecNo, 11 ] cVar = "N" + LEFT( cField, RAT( "_", cField ) - 1 ) DO CASE CASE cVar = "NCK_CHEZ" nRecNo = NCK_CHEZ npRecNo = aObjPoint[ nRecNo ] nCurrent = nRecNo nCurrGrp = aClkObj[ npRecNo, 5 ] CASE cVar = "NRB_CONS" nRecNo = NRB_CONS npRecNo = aObjPoint[ nRecNo ] nCurrent = nRecNo nCurrGrp = aClkObj[ npRecNo, 5 ] ENDCASE IF lExit EXIT ENDIF ENDDO DO HasTitle WITH nCurrent, BN_HILITE ENDCASE ELSE *------------------------------------------------------- *-- Handle direct moves to objects via Alt key and Mouse *------------------------------------------------------- IF .NOT. WhenOk( p__dir ) nMess = 0 RETURN ENDIF *-------------------------------------------------------------- *-- Check to see if we are leaving or going into a radio button *-- group. If so, we may have to toggle off the current dot. *-------------------------------------------------------------- DO CASE *----------------------------------------------------------- *-- If the current object is a radio button and the group to *-- move into is the same, then... *----------------------------------------------------------- CASE LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) = "RB_" .AND. ; aClkObj[ aObjPoint[ p__dir ], 5 ] = nCurrGrp DO CASE CASE nCurrent = 6 STORE .F. TO RB_CONS_1 DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent CASE nCurrent = 8 STORE .F. TO RB_CONS_2 DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent CASE nCurrent = 10 STORE .F. TO RB_CONS_3 DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent ENDCASE *--------------------------------------------- *-- If we are moving into a radio button group *--------------------------------------------- CASE LEFT( aClkObj[ aObjPoint[ p__dir ], 11 ], 3 ) = "RB_" DO CASE CASE p__dir = 6 IF p__dir <> nRB_CONS cField = aClkObj[ aObjPoint[ nRB_CONS ], 11 ] STORE .F. TO &cField DO TButton WITH WM_PAINT, BN_UNHILITE, nRB_CONS ENDIF CASE p__dir = 8 IF p__dir <> nRB_CONS cField = aClkObj[ aObjPoint[ nRB_CONS ], 11 ] STORE .F. TO &cField DO TButton WITH WM_PAINT, BN_UNHILITE, nRB_CONS ENDIF CASE p__dir = 10 IF p__dir <> nRB_CONS cField = aClkObj[ aObjPoint[ nRB_CONS ], 11 ] STORE .F. TO &cField DO TButton WITH WM_PAINT, BN_UNHILITE, nRB_CONS ENDIF ENDCASE ENDCASE IF nCurrGrp <> aClkObj[ aObjPoint[ p__dir ], 5 ] DO HasTitle WITH nCurrent, BN_UNHILITE DO HasTitle WITH p__dir, BN_HILITE nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] DO CASE CASE nCurrent = 13 DO TButton WITH BN_CLICKED, .F., nCurrent CASE nCurrent = 14 DO TButton WITH BN_CLICKED, .F., nCurrent ENDCASE ELSE DO HasTitle WITH p__dir, BN_HILITE ENDIF nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] ENDIF *--------------------------------------------------------------- *-- Repaint the Default button if we were on a button before and *-- the target is not a button. *--------------------------------------------------------------- cCurrClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) IF cPrevClass = "BT_" .AND. cCurrClass <> "BT_" DO TButton WITH WM_PAINT, BN_DEFAULT, nDlgDef STORE .T. TO BT_OK ENDIF *--------------------------------------------------------- *-- Save the current CK or RB pointer for the target group *--------------------------------------------------------- DO CASE CASE nCurrent = 5 && CK_CHEZ_1 STORE nCurrent TO nCK_CHEZ IF TYPE( "p__dir" ) = "N" DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 7 && CK_CHEZ_2 STORE nCurrent TO nCK_CHEZ IF TYPE( "p__dir" ) = "N" DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 9 && CK_CHEZ_3 STORE nCurrent TO nCK_CHEZ IF TYPE( "p__dir" ) = "N" DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 6 && RB_CONS_1 STORE nCurrent TO nRB_CONS IF TYPE( "p__dir" ) = "N" STORE .F. TO RB_CONS_1 DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 8 && RB_CONS_2 STORE nCurrent TO nRB_CONS IF TYPE( "p__dir" ) = "N" STORE .F. TO RB_CONS_2 DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 10 && RB_CONS_3 STORE nCurrent TO nRB_CONS IF TYPE( "p__dir" ) = "N" STORE .F. TO RB_CONS_3 DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 13 && BT_OK STORE nCurrent TO nBT IF TYPE( "p__dir" ) = "N" STORE .T. TO BT_OK ENDIF CASE nCurrent = 14 && BT_CANCEL STORE nCurrent TO nBT IF TYPE( "p__dir" ) = "N" STORE .T. TO BT_CANCEL ENDIF ENDCASE RETURN *-- EOP: GetNext WITH p__dir, pl_SameGrp FUNCTION WhenOk PARAMETERS pnTarget *---------------------------------------------------------------------------- * NAME * WhenOk - Validate the WHEN condition for a target object * * DESCRIPTION * * PARAMETERS * pnTarget = Object ID to verify against * *---------------------------------------------------------------------------- PRIVATE lWhenOk lWhenOk = .T. RETURN lWhenOk *-- EOF: WhenOk( pnTarget ) FUNCTION GetId PARAMETERS pcVar *---------------------------------------------------------------------------- * NAME * GetId() - Search for memvar name and return current_id *---------------------------------------------------------------------------- PRIVATE nId nId = 0 DO CASE CASE pcVar = "CK_CHEZ_0" nId = 3 CASE pcVar = "RB_CONS_0" nId = 4 CASE pcVar = "CK_CHEZ_1" nId = 5 CASE pcVar = "RB_CONS_1" nId = 6 CASE pcVar = "CK_CHEZ_2" nId = 7 CASE pcVar = "RB_CONS_2" nId = 8 CASE pcVar = "CK_CHEZ_3" nId = 9 CASE pcVar = "RB_CONS_3" nId = 10 CASE pcVar = "EF_DELV_0" nId = 11 CASE pcVar = "EF_DELV_1" nId = 12 CASE pcVar = "BT_OK" nId = 13 CASE pcVar = "BT_CANCEL" nId = 14 ENDCASE RETURN( nId ) *-- EOF: GetId( pcVar) PROCEDURE PostVals *---------------------------------------------------------------------------- * NAME * PostVals - * * DESCRIPTION * *---------------------------------------------------------------------------- IF TYPE( "TVDIAL[1]" ) <> "U" TVDIAL[ 1 ] = CK_CHEZ_1 TVDIAL[ 2 ] = CK_CHEZ_2 TVDIAL[ 3 ] = CK_CHEZ_3 TVDIAL[ 4 ] = RB_CONS_1 TVDIAL[ 5 ] = RB_CONS_2 TVDIAL[ 6 ] = RB_CONS_3 TVDIAL[ 7 ] = EF_DELV_1 TVDIAL[ 8 ] = BT_OK TVDIAL[ 9 ] = BT_CANCEL ENDIF RETURN *-- EOP: PostVals PROCEDURE ReleObjs *---------------------------------------------------------------------------- * NAME * ReleObjs - Scan the design DBF file and release the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- RETURN *-- EOP: ReleObjs PROCEDURE ITVDIAL *---------------------------------------------------------------------------- * NAME * ITVDIAL - Builds the Initialization array for this dialog box * * DESCRIPTION * ITVDIAL with create a routine that you can call or cut from this * file to run a dialog box and capture the data on exit. * * To run the dialog box, * SET PROCEDURE TO TVDIAL * DO ITVDIAL * * Running ITVDIAL with use the defaults from the SCR file. The * array will remain in memory after execution. * * REMEMBER, REGENERATING THE DIALOG BOX WILL OVERWRITE THIS PROCEDURE! * *---------------------------------------------------------------------------- PUBLIC ARRAY TVDIAL[ 9 ] *-- CK_CHEZ_1 - [ ] ~Hvarti TVDIAL[ 1 ] = .F. *-- CK_CHEZ_2 - [ ] ~Tilset TVDIAL[ 2 ] = .F. *-- CK_CHEZ_3 - [ ] ~Jarlsberg TVDIAL[ 3 ] = .F. *-- RB_CONS_1 - ( ) ~Solid TVDIAL[ 4 ] = .F. *-- RB_CONS_2 - ( ) ~Runny TVDIAL[ 5 ] = .F. *-- RB_CONS_3 - ( ) ~Melted TVDIAL[ 6 ] = .T. *-- EF_DELV_1 - XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX TVDIAL[ 7 ] = "PHONE HOME" + SPACE( 25 ) *-- BT_OK - ~Ok TVDIAL[ 8 ] = .T. *-- BT_CANCEL - ~Cancel TVDIAL[ 9 ] = .F. *-------------------------------------------------------------- *-- FXL_Cancel is set to .T. is the user Cancels the dialog box *-------------------------------------------------------------- FXL_Cancel = .F. *-------------------------------------------------------------- *-- FXL_NoChng lets the dialog box know that the values in the *-- array are not different from the SCR file defaults. This *-- will allow the dialog box to use the .WIN file for a faster *-- startup. *-------------------------------------------------------------- FXL_NoChng = .T. DO TVDIAL IF .NOT. FXL_Cancel && The user clicked on OK *----------------------------------- *-- Put your Ok processing code here *----------------------------------- ENDIF RELEASE TVDIAL RETURN *-- EOP: ITVDIAL